home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / Strings / StringLists.p
Encoding:
Text File  |  1992-04-18  |  4.8 KB  |  153 lines  |  [TEXT/PJMM]
  1. unit StringLists;
  2.  
  3. interface
  4.  
  5. {The Set… routines create intervening zero–length strings if needed}
  6. {to fill the list up to the specified index. The Delete… routines ignore}
  7. {requests to delete strings at nonexistent indices. All routines ignore}
  8. {nil handles, missing resources, and negative indices.}
  9.     procedure RSetIndString (theString: Str255; rType: ResType; strListID: INTEGER; index: INTEGER);
  10.     procedure HSetIndString (theString: Str255; strListHandle: Handle; index: INTEGER);
  11.     procedure RGetIndString (var theString: Str255; var found: Boolean; rType: ResType; strListID: INTEGER; index: INTEGER);
  12.     procedure HGetIndString (var theString: Str255; var found: Boolean; strListHandle: Handle; index: INTEGER);
  13.     procedure RDeleteIndString (rType: ResType; strListID: INTEGER; index: INTEGER);
  14.     procedure HDeleteIndString (strListHandle: Handle; index: INTEGER);
  15.     function RCountIndString (rType: ResType; strListID: INTEGER): Integer;
  16.     function HCountIndString (strListHandle: Handle): Integer;
  17.  
  18. implementation
  19.  
  20.     type
  21.         StringCount = Integer;
  22.         StringCountPtr = ^StringCount;
  23.         StringCountHandle = ^StringCountPtr;
  24.  
  25.     function FindString (strListHandle: Handle; index: Integer; var aStrPtr: Ptr; var offset: Longint; var length: Integer): Boolean;
  26.         var
  27.             i, limitIndex: Integer;
  28.             pastEnd: Boolean;
  29.     begin
  30.         aStrPtr := nil;
  31.         limitIndex := StringCountHandle(strListHandle)^^;
  32.         pastEnd := index > limitIndex;
  33.         if pastEnd then
  34.             index := limitIndex + 1;
  35.         if (strListHandle <> nil) & (index > 0) then
  36.             begin
  37.                 offset := SIZEOF(StringCount);
  38.                 aStrPtr := Ptr(ORD(strListHandle^) + offset);
  39.                 length := aStrPtr^ + SIZEOF(SignedByte);
  40.                 i := 1;
  41.                 while i < index do
  42.                     begin
  43.                         aStrPtr := Ptr(ORD(aStrPtr) + length);
  44.                         offset := offset + length;
  45.                         length := aStrPtr^ + SIZEOF(SignedByte);
  46.                         i := i + 1;
  47.                     end;
  48.                 if pastEnd then
  49.                     length := 0;
  50.                 FindString := not pastEnd;
  51.             end
  52.         else
  53.             FindString := False;
  54.     end;
  55.  
  56.     procedure HSetIndString (theString: Str255; strListHandle: Handle; index: INTEGER);
  57.         var
  58.             aStrPtr: Ptr;
  59.             i: Integer;
  60.             offset, ignore: Longint;
  61.             oldLength, newLength, padStringCount: Integer;
  62.     begin
  63.         newLength := length(theString) + SIZEOF(SignedByte);
  64.         if FindString(strListHandle, index, aStrPtr, offset, oldLength) then
  65.             begin
  66.                 ignore := Munger(strListHandle, offset, nil, oldLength, @theString, newLength);
  67.             end
  68.         else
  69.             begin
  70.                 padStringCount := index - StringCountHandle(strListHandle)^^ - 1;
  71.                 aStrPtr := Ptr(ORD(@theString) - padStringCount * SIZEOF(SignedByte));
  72.                 ignore := Munger(strListHandle, offset, nil, oldLength, aStrPtr, newLength + padStringCount);
  73.                 aStrPtr := Ptr(ORD(strListHandle^) + offset);
  74.                 for i := 1 to padStringCount do
  75.                     begin
  76.                         aStrPtr^ := 0;
  77.                         aStrPtr := Ptr(ORD(aStrPtr) + SIZEOF(SignedByte));
  78.                     end;
  79.                 StringCountHandle(strListHandle)^^ := StringCountHandle(strListHandle)^^ + padStringCount + 1;
  80.             end;
  81.     end;
  82.  
  83.     procedure RSetIndString (theString: Str255; rType: ResType; strListID: INTEGER; index: INTEGER);
  84.         var
  85.             theStrList: Handle;
  86.     begin
  87.         theStrList := GetResource(rType, strListID);
  88.         HSetIndString(theString, theStrList, index);
  89.         ChangedResource(theStrList);
  90.         WriteResource(theStrList);
  91.     end;
  92.  
  93.     procedure HGetIndString (var theString: Str255; var found: Boolean; strListHandle: Handle; index: INTEGER);
  94.         var
  95.             aStrPtr: Ptr;
  96.             offset: Longint;
  97.             length: Integer;
  98.     begin
  99.         found := FindString(strListHandle, index, aStrPtr, offset, length);
  100.         if found then
  101.             BlockMove(aStrPtr, @theString, length)
  102.         else
  103.             theString := '';
  104.     end;
  105.  
  106.     procedure RGetIndString (var theString: Str255; var found: Boolean; rType: ResType; strListID: INTEGER; index: INTEGER);
  107.         var
  108.             theStrList: Handle;
  109.     begin
  110.         theStrList := GetResource(rType, strListID);
  111.         HGetIndString(theString, found, theStrList, index);
  112.     end;
  113.  
  114.     procedure HDeleteIndString (strListHandle: Handle; index: INTEGER);
  115.         var
  116.             aStrPtr: Ptr;
  117.             offset: Longint;
  118.             length: Integer;
  119.     begin
  120.         if FindString(strListHandle, index, aStrPtr, offset, length) then
  121.             begin
  122.                 offset := Munger(strListHandle, offset, nil, length, Ptr(-1), 0);
  123.                 StringCountHandle(strListHandle)^^ := StringCountHandle(strListHandle)^^ - 1;
  124.             end;
  125.     end;
  126.  
  127.     procedure RDeleteIndString (rType: ResType; strListID: INTEGER; index: INTEGER);
  128.         var
  129.             theStrList: Handle;
  130.     begin
  131.         theStrList := GetResource(rType, strListID);
  132.         HDeleteIndString(theStrList, index);
  133.         ChangedResource(theStrList);
  134.         WriteResource(theStrList);
  135.     end;
  136.  
  137.     function HCountIndString (strListHandle: Handle): Integer;
  138.     begin
  139.         if strListHandle = nil then
  140.             HCountIndString := 0
  141.         else
  142.             HCountIndString := StringCountHandle(strListHandle)^^;
  143.     end;
  144.  
  145.     function RCountIndString (rType: ResType; strListID: INTEGER): Integer;
  146.         var
  147.             theStrList: Handle;
  148.     begin
  149.         theStrList := GetResource(rType, strListID);
  150.         RCountIndString := HCountIndString(theStrList);
  151.     end;
  152.  
  153. end.